home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
Fast-BV
/
Fast-bv.lap.lisp
< prev
next >
Wrap
Text File
|
1993-04-20
|
11KB
|
256 lines
;;;; Assembly (LAP) code for Fast Bit Vectors unit.
;;;; D.B.Lamkins
; procedure NextBit_Inline(table: Ptr; bvPtr: Ptr; var index: Integer);
; A bit-vector (bv) is an integer bit count followed by the bits.
; The bit indices start at 0 and increase left-to-right.
; The table is indexed -8..255, mapping (index->value)
; -8->$FF, -7->$7F, -6->$3F, -5->$1F, -4->$0F, -3->$07, -2->$03, -1->$01,
; 1->-1, 2..3->-2, 4..7->-3, 8..15->-4, 16..31->-5, 32..63->-6,
; 64..127->-7, and 128..255->-8.
; NextBit_Inline expects the address of table[0].
; NextBit_Inline returns the index of the next set bit.
; When there are no more set bits, the returned index is -1.
(hex-lap-list
(movem.l #(a2 d3) -@sp) ; save registers we'll clobber
(move.l sp@+ a1) ; reference to the index parameter
(move.w @a1 d0) ; the starting index
(move.l sp@+ a0) ; pointer to the bit-vector
(move.l sp@+ a2) ; pointer to the lookup table
(move.l a1 -@sp) ; save the index reference
(move.w a0@+ d2) ; get bv length
; also advance to bit data
(move.l a0 a1) ; remember where the bits begin
(add.w ($ 1) d0) ; advance index past last found bit
(cmp.w d2 d0) ; test for finished
(bge @2) ; no bits left - bail out
(move.w d0 d3) ; remember the new starting index
(lsr.w 3 d0) ; compute byte offset
(ext.l d0)
(add.l d0 a0) ; set starting position
(add.w ($ 7) d2) ; set up loop count
(lsr.w 3 d2)
(sub.w d0 d2)
(sub.w ($ 1) d2)
(clr.w d1)
(move.b a0@+ d1) ; get first byte
(and.w ($ 7) d3) ; mask according to starting offset
(and.b (a2 d3.w -8) d1)
(bra @1.5)
@1
(move.b a0@+ d1) ; fetch next byte from vector
@1.5
(dbne d2 @1) ; repeat until non-zero
(beq @2) ; bail out if we reached the end
(move.b (a2 d1.w) d1) ; lookup set bit's position offset
(ext.w d1) ; (need sign extension for later)
(sub.l a1 a0) ; compute byte offset of found bit
(move.w a0 d0) ; (+1, fixed by position lookup)
(lsl.w 3 d0) ; multiply by 8 bits per byte
(add.w d0 d1) ; add the position of the set bit
(bra @3)
@2
(move.w ($ -1) d1) ; set up return for "no more bits"
@3
(move.l sp@+ a1) ; recall the index reference
(move.w d1 @a1) ; return what we found
(movem.l sp@+ #(a2 d3)) ; restore clobbered registers
)
; procedure BlockFill_Inline(value: SignedByte; block: Ptr; length: Integer);
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a0) ; block address
(move.w sp@+ d0) ; fill value
@1
(move.b d0 a0@+) ; fill each byte
(dbf d1 @1)
)
; procedure BlockAND_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a0@+ d0) ; loop over srcs, result to dst
(and.b a1@+ d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; procedure BlockOR_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a0@+ d0) ; loop over srcs, result to dst
(or.b a1@+ d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; procedure BlockEOR_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a0@+ d0) ; loop over srcs, result to dst
(move.b a1@+ d1)
(eor.b d1 d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; procedure BlockNOT_Inline (src, dst: Ptr; length: Integer);
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a1) ; dst block address
(move.l sp@+ a0) ; src block address
@1
(move.b a0@+ d0) ; loop over src, result to dst
(not.b d0)
(move.b d0 a1@+)
(dbf d1 @1)
)
; function BlockEqual_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a1) ; bv2 block address
(move.l sp@+ a0) ; bv1 block address
@1
(cmp.b a0@+ a1@+) ; loop over blocks, leave on mismatch
(dbne d1 @1)
(seq.b (sp 1)) ; return true if equal
(neg.b (sp 1))
)
; function BlockAllClear_Inline (bv: Ptr; length: Integer):Boolean;
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a0) ; bv block address
@1
(tst.b a0@+) ; loop over block, leave on nonzero
(dbne d1 @1)
(seq.b (sp 1)) ; return true if all zero
(neg.b (sp 1))
)
; function BlockAllSet_Inline (bv: Ptr; length: Integer): Boolean;
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a0) ; bv block address
@1
(tst.b a0@+) ; loop over block, leave on zero
(dbeq d1 @1)
(sne.b (sp 1)) ; return true if all ones
(neg.b (sp 1))
)
; procedure BlockANDCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a1@+ d0) ; loop over srcs, result to dst
(not.b d0)
(and.b a0@+ d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; procedure BlockORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a1@+ d0) ; loop over srcs, result to dst
(not.b d0)
(or.b a0@+ d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; procedure BlockEORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
(hex-lap-list
(move.l a2 -@sp) ; can't clobber this
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a2) ; dst block address
(move.l sp@+ a1) ; src2 block address
(move.l sp@+ a0) ; src1 block address
@1
(move.b a1@+ d1) ; loop over srcs, result to dst
(not.b d1)
(move.b a0@+ d0)
(eor.b d1 d0)
(move.b d0 a2@+)
(dbf d1 @1)
(move.l sp@+ a2) ; restore clobbered reg
)
; function BlockUnequal_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
(hex-lap-list
(move.w sp@+ d1) ; length
(sub.w ($ 1) d1) ; adjust for DBcc
(move.l sp@+ a1) ; bv2 block address
(move.l sp@+ a0) ; bv1 block address
@1
(cmp.b a0@+ a1@+) ; loop over blocks, leave on match
(dbeq d1 @1)
(sne.b (sp 1)) ; return true if unequal
(neg.b (sp 1))
)
; procedure BlockShiftBitsLeft_Inline(src, dst: Ptr; shift, length: Integer);
(hex-lap-list
(movem.l #(d3 d4) -@sp) ; save regs that we can't clobber
(move.w sp@+ d4) ; get length
(sub.w ($ 1) d4) ; adjust for loop count
(move.w sp@+ d2) ; get shift count (1..7)
(move.w d2 d3) ; compute complementary shift count
(neg.w d3)
(add.w ($ 8) d3)
(move.l sp@+ a1) ; get destination block ptr
(move.l sp@+ a0) ; get source block ptr
@1 ; loop over blocks while shifting
(clr.w d0)
(move.b a0@+ d0) ; load 'left' byte
(lsl.b d2 d0) ; shift left by count
(move.b @a0 d1) ; load 'right' byte
(lsr.b d3 d1) ; shift right by 8-count
(or.b d1 d0) ; merge left and right bytes, shifted
(move.b d0 a1@+) ; stuff into the result block
(dbf d4 @1) ; repeat until finished
(movem.l sp@+ #(d3 d4)) ; restore clobbered regs
)